home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Utilities / Text Utils / Alpha 5.81 ƒ / Tcl / SystemCode / procs.tcl.back < prev    next >
Encoding:
Text File  |  1994-03-08  |  9.0 KB  |  432 lines  |  [TEXT/ALFA]
  1. #==============================================================================
  2. proc normalLeftBracket {} {
  3.     insertText "\{"
  4. }
  5. proc normalRightBracket {} {
  6.     insertText "\}"
  7. }
  8. bind '\[' <zs>  normalLeftBracket
  9. bind '\]' <zs>  normalRightBracket
  10. #==============================================================================
  11.  
  12.             
  13. # Select the next or current word. If word already selected, will go to next.
  14. proc hiliteWord {} {
  15.     if {[getPos]!=[selEnd]}    forwardChar
  16.     forwardWord
  17.     set start [getPos]
  18.     backwardWord
  19.     select $start [getPos]
  20. }
  21.  
  22. bind 'h' <z> hiliteWord
  23.  
  24. # For mark stack.
  25. set markName 0
  26. set markStack ""
  27.  
  28.  
  29. #=============================================================================
  30. # Hook procs recognized: "openHook", "closeHook", "activateHook", "deactivateHook", 
  31. #                          "suspendHook", "saveasHook", "saveHook", and "resumeHook".
  32. #=============================================================================
  33.  
  34. # Event hooks - set specific modes when files opened.
  35. proc openHook name {
  36.     global winModes
  37.     $winModes($name)
  38.     if {$name == {*Toolserver shell*}} startMPW
  39.     addWinName $name
  40. }
  41.  
  42. # full pathname
  43. proc saveHook name {
  44.     global backup
  45.     if ($backup) {
  46.         catch {rm $name~}
  47.         cp $name $name~
  48.     }
  49. }
  50.  
  51. # Clean up the mark stack.
  52. proc closeHook name {
  53.     global markStack
  54.     global winModes
  55.     unset winModes($name)
  56.     if [llength $markStack] {
  57.         set markStack [removePat $markStack $name*]
  58.     }
  59.     removeWinName $name
  60. }
  61.  
  62. proc saveasHook {oldName newName} {
  63.     global winModes
  64.     removeWinName $oldName
  65.     addWinName $newName
  66.     setWinMode $newName
  67.     $winModes($newName)
  68. }
  69.  
  70.  
  71. proc activateHook name {
  72.     global winModes
  73.     if {[catch {$winModes($name)}]} {
  74.         setWinMode $name
  75.         $winModes($name)
  76.     }
  77. }
  78.  
  79.  
  80. set winModes("") ""
  81.  
  82. proc setWinMode name {
  83.     global winModes
  84.     set nm [file tail $name]
  85.     case $name in {
  86.         "*.c"         {     set winModes($name) setCMode }
  87.         "*.tex"        {     set winModes($name) setTexMode; winFuncTitle $nm "Sect" }
  88.         "*.cc"        {     set winModes($name) setC++Mode; winFuncTitle $nm "Meth" }
  89.         "*.cp"        {     set winModes($name) setC++Mode; winFuncTitle $nm "Meth" }
  90.         "*.C"        {     set winModes($name) setC++Mode; winFuncTitle $nm "Meth" }
  91.         "*.h"         {     set winModes($name) setCMode }
  92.         "*.f"          {     set winModes($name) setFortranMode }
  93.         "*.tcl"     {     set winModes($name) setTclMode; winFuncTitle $nm "Proc" }
  94.         {*Toolserver\ sh*}    {     set winModes($name) setMPWMode; winFuncTitle $nm "Proc" }
  95.         {*tcl\ sh*}    {     set winModes($name) setShellMode; winFuncTitle $nm "Proc" }
  96.         "*.sty"        {     set winModes($name) setTexMode; winFuncTitle $nm "Sect" }
  97.         "Browser"    {     set winModes($name) setBrowseMode }
  98.         default        {     set winModes($name) setTextMode }
  99.     }
  100. }
  101.  
  102.  
  103. # 'modes' is inspected by alpha for the popup mode menu. 'newMode' is 
  104. # called by Alpha in case of a successful choice.
  105. set modes { C C++ Csh Fort MPW Tcl TeX Text }
  106.  
  107. set modeProcs(C)         setCMode
  108. set modeProcs(C++)         setC++Mode
  109. set modeProcs(Csh)         setShellMode
  110. set modeProcs(Fort)     setFortranMode
  111. set modeProcs(MPW)         setMPWMode
  112. set modeProcs(Tcl)         setTclMode
  113. set modeProcs(TeX)         setTexMode
  114. set modeProcs(Text)     setTextMode
  115.  
  116. proc newMode mode {
  117.     global winModes
  118.     global modeProcs
  119.     
  120.     set name [lindex [winNames -f] 0]
  121.     $modeProcs($mode)
  122.     set winModes($name) $modeProcs($mode)
  123. }
  124.  
  125.  
  126. proc deactivateHook name {
  127. }
  128.  
  129. proc suspendHook name {
  130.     global iconifyOnSwitch
  131.     global suspIconed
  132.     if {$iconifyOnSwitch} {
  133.         set wins [winNames -f]
  134.         foreach win $wins {
  135.             if {![icon -f "$win" -q]} {
  136.                 set suspIconed($win) 1
  137.                 icon -f "$win" -t
  138.             }
  139.         }
  140.     }
  141. }
  142.  
  143. proc resumeHook name {
  144.     global iconifyOnSwitch resumeRevert suspIconed
  145.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  146.         set wins [winNames -f]
  147.         foreach win [array names suspIconed] {
  148.             icon -f "$win" -o
  149.         }
  150.         unset suspIconed
  151.     }
  152.     if {$resumeRevert} {
  153.         set resumeRevert 0
  154.         revert
  155.     }
  156. }
  157.  
  158. # Handles dynamically adding and deleting window names from menu.
  159. proc addWinName name {
  160.     global winNameToNum
  161.     global winNumToName
  162.     global fullNames
  163.     
  164.     for {set i 0} {$i<100} {incr i} {
  165.         if {[catch {set nm $winNumToName($i)} res] == "1"} {
  166.             if {$fullNames != "0"} {
  167.                 set nm $name
  168.             } else {
  169.                 regexp {[^:]*$} $name nm
  170.             }
  171.             if {$i < 10} {
  172.                 addMenuItem -m -l "/$i" Wins $nm
  173.             } else {
  174.                 addMenuItem -m -l "" Wins $nm
  175.             }
  176.             set winNumToName($i) $name
  177.             set winNameToNum($name) $i
  178.             return
  179.         }
  180.     }
  181. }
  182.  
  183. proc removeWinName name {
  184.     global winNameToNum
  185.     global winNumToName
  186.     global fullNames
  187.     
  188.     set num $winNameToNum($name)
  189.     unset winNumToName($num)
  190.     unset winNameToNum($name)
  191.     if {$fullNames == "1"} {
  192.         deleteMenuItem -m Wins $name
  193.     } else {
  194.         regexp {[^:]*$} $name nm
  195.         deleteMenuItem -m Wins $nm
  196.     }
  197. }
  198.  
  199.  
  200. proc menuWin {menu name} {
  201.     global winNameToNum
  202.  
  203.     set nms [array names winNameToNum]
  204.     foreach nm $nms {
  205.         if {[string match *$name $nm] == "1"}  {
  206.             bringToFront $name
  207.             if [icon -q] { icon -f $name -o }
  208.             return
  209.         }
  210.     }
  211.     return "normal"
  212. }
  213.  
  214.  
  215. set lastMode 0
  216.  
  217. # rta  Creating texWasLast variable
  218. set texWasLast 0
  219. # rta Following changed from ThinkC to MPW
  220.  
  221.  
  222. # Modes
  223.  
  224. # Fortran programming mode 
  225. proc setFortranMode {} {
  226.     changeMode "Fort"
  227.     uplevel #0 {
  228.         set elecLBrace 0
  229.         set elecRBrace 0
  230.         set electricSemi 0
  231.         set wordWrap 0
  232.         set funcExpr {^(      |\t)(subroutine|.*function|SUBROUTINE|.*FUNCTION).*\(.*$}
  233.         set sortedIsDefault 0
  234.     }
  235. }
  236.  
  237.  
  238. # Ordinary, default mode
  239. proc setTextMode {} {
  240.     changeMode "Text"
  241.     uplevel #0 {
  242.         set elecLBrace 0
  243.         set elecRBrace 0
  244.         set electricSemi 0
  245.         set wordWrap 1
  246.         set prefixString "> "
  247.         set suffixString " <--"
  248.     }
  249. }
  250.  
  251.  
  252. #================================================================================
  253.  
  254. # Instantiate a global variable to the path of a file (usually an app). As a
  255. # side-effect, make the instantiation permanent by adding a line to 'definitions.tcl'.
  256. proc addAppPath {name var} {
  257.     global $var
  258.     
  259.     if {[catch {getfile "Find '$name' app:"} path]} {return 1}
  260.     set $var $path
  261.  
  262.     addUserLine "set $var \"[quoteExpr2 $path]\""
  263.     return 0
  264. }
  265.  
  266. proc addUserLine {line} {
  267.     global HOME
  268.  
  269.     if {[file exists "$HOME:userStartup.tcl"]} {
  270.         set fid [open "$HOME:userStartup.tcl" "a"]
  271.     } else {
  272.         set fid [open "$HOME:userStartup.tcl" "w"]
  273.     }
  274.     puts $fid $line
  275.     close $fid
  276. }
  277.  
  278.  
  279. proc getFileSig {f} {
  280.     catch {lindex [ls -l $f] 5} var
  281.     return $var
  282. }
  283.  
  284.  
  285. # Look for given app sig in active processes. If not there, try to 
  286. # launch with 'path' prompting for 'path' if necessary.
  287. # Return the real name of the app. Don't switch.
  288. proc checkRunning {name sig path} {
  289.     global $path
  290.     foreach proc [processes] {
  291.         if {[lindex $proc 1] == $sig} {
  292.             return [lindex $proc 0]
  293.         }
  294.     }
  295.     if {![file exists [set $path]]} {
  296.         alertnote "'[set $path]' does not exist!"
  297.         error ""
  298.     }
  299.     if {[catch {getFileSig [set $path]}]} {
  300.         if {[addAppPath $name $path]} return
  301.     }
  302.     set sig [getFileSig [set $path]]
  303.     if {[catch {launch -f [set $path]}]} {
  304.         error "Problem with script."
  305.     }
  306.     return [file tail [set $path]]
  307. #    return [checkRunning $name $sig $path]
  308. }
  309.  
  310. #================================================================================
  311. # Excalibur is the only Mac spell-checker that I know of which will handle LaTex as
  312. # well as ordinary text.
  313.  
  314. set excaliburMenu "•128"
  315.  
  316. proc spellcheckWindow {} {
  317.     global excaliburPath resumeRevert
  318.  
  319.     catch {checkRunning Excalibur XCLB excaliburPath} name
  320.  
  321.     if {[winInfo dirty]} {
  322.         if {[askyesno "Save '[lindex [winNames] 0]'?"] == "yes"} {
  323.             save
  324.         }
  325.     }
  326.     if {[catch {sendOpenEvent -n $name [lindex [winNames -f] 0]}] } {
  327.         beep 
  328.     } else {
  329.         switchTo $name
  330.     }
  331.     set resumeRevert 1
  332. }
  333.  
  334. proc spellcheckSelection {} {
  335.     global excaliburPath 
  336.  
  337.     catch {checkRunning Excalibur XCLB excaliburPath} name
  338.  
  339.     if {[getPos] == [selEnd]} {
  340.         beep
  341.         message "No selection"
  342.         return;
  343.     }
  344.     copy
  345.     switchTo $name
  346. }
  347.  
  348. menu -n $excaliburMenu {
  349.     "spellcheckWindow"
  350. }
  351. insertMenu    $excaliburMenu
  352.  
  353. #================================================================================
  354.  
  355.  
  356. proc changeMode {newMode} {
  357.     global lastMode
  358.     global savedIsMeta
  359.     global wordBreak
  360.     global wordBreakPreface
  361.     global optionIsMeta
  362.     global latexMenu excaliburMenu thinkMenu toolserverMenu
  363.     
  364.     displayMode $newMode
  365.     if {$lastMode == $newMode} return
  366.     
  367.     case $lastMode in {
  368.         "Tex" {
  369.             set optionIsMeta $savedIsMeta
  370.             set wordBreakPreface {[^a-zA-Z0-9_]}
  371.             set wordBreak {[a-zA-Z0-9_]+}
  372.             set optionIsMeta 1
  373.             catch {removeMenu $latexMenu}
  374.             insertMenu $excaliburMenu
  375.         }
  376.         "Csh" {
  377.             catch {removeMenu "Tcl"}
  378.         }
  379.         "Tcl" {
  380.             catch {removeMenu "Tcl"}
  381.         }
  382.         "BRWZ" {
  383.             catch {removeMenu "Browse"}
  384.         }
  385.         "C" {
  386.             catch {removeMenu    $thinkMenu}
  387.             catch {removeMenu    $toolserverMenu}
  388.         }
  389.         "C++" {
  390.             catch {removeMenu    $thinkMenu}
  391.             catch {removeMenu    $toolserverMenu}
  392.         }
  393.     }
  394.     global mode
  395.     set mode $newMode
  396.     set lastMode $newMode
  397. }
  398.     
  399.  
  400. proc alphaHelp {} {
  401.     global HOME
  402.     edit -r -m "$HOME:Help:General Help"
  403. }
  404.  
  405.  
  406. set patternLibrary {
  407.     { "Pascal to C Comments" {\{([^\}]*)\}} {/* \1 */} }
  408.     { "C++ to C Comments" {//(.*)} {/* \1 */}}
  409. }
  410.  
  411.  
  412. proc dividingLine {} {
  413.     insertText "================================================================================\r"
  414. }
  415. bind 'l' <C> dividingLine
  416.  
  417.  
  418. #================================================================================
  419.  
  420. if {[catch {info args oldCd}]} {
  421.     rename cd oldCd
  422. }
  423.  
  424. proc cd args {
  425.     global HOME
  426.     if {[llength $args]} {
  427.         oldCd [string trim [eval list $args] "\{\}"]
  428.     } else {
  429.         oldCd $HOME
  430.     }
  431. }
  432.